找传奇、传世资源到传世资源站!

文件切割器

8.5玩家评分(1人评分)
下载后可评
介绍 评论 失效链接反馈

文件切割器实现将大文件切割成很多小文件,可以自定义文件大小from clipboardunit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, FileCtrl, destPath;

type
  TXCutForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    RadioGroup1: TRadioGroup;
    TabSheet2: TTabSheet;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    PrbCut: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  XCutForm: TXCutForm;
  FilePath:String;     //存放文件名和路径
  Dir:String;          //存放目标文件夹路径

implementation

uses Math;

{$R *.dfm}

procedure TXCutForm.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute
  then
  begin
    FilePath:=OpenDialog1.FileName;
    Button2.Enabled:=true;
    Button3.Enabled:=true;
  end;
end;

procedure TXCutForm.Button2Click(Sender: TObject);
begin
  DestPathForm.Show;
end;

procedure TXCutForm.Button3Click(Sender: TObject);
var
  fs:TFileStream;
  ms:TmemoryStream;
  filesize,filecount:integer;
  bat:TextFile;
  i:integer;
begin
  if PageControl1.ActivePage=TabSheet1
  then
  begin
  case RadioGroup1.ItemIndex of
    0: filesize := 2000 * 1024; //2000 K
    1: filesize := 1440 * 1024; //1440 K
    2: filesize := 1200 * 1024; //1200 K
    3: filesize := 1000 * 1024; //1000 K
    4: filesize := 720 * 1024; //720 K
    5: filesize := 500 * 1024; //500 K
    6: filesize := 300 * 1024; //300 K
    7: filesize := 200 * 1024; //200 K
  else filesize := 100 * 1024; //100 K
  end;
  end
  else filesize:= StrToInt(Edit1.text)*1024;

  fs := TFileStream.Create(filepath, fmopenread);
  ms := TMemoryStream.Create;
  FileCount := 1;

  prbCut.Min := 0;
  prbCut.Max := (fs.size div filesize) 1;
  prbCut.step := 1;

  while fs.Position < fs.Size - 1 do
  begin
  ms.position := 0;
  ms.size := 0;

  if fs.size - fs.Position < FileSize
  then FileSize := fs.size - fs.position;

  ms.CopyFrom(fs, FileSize);
  application.ProcessMessages;

  prbCut.StepIt;
  ms.SaveToFile(dir '\' extractfilename(filepath) '.' inttostr(FileCount));
  memo1.lines.add('正在生成第 ' inttostr(FileCount) ' 个文件!');
  inc(FileCount);
  end;

  assignfile(bat, dir '\' changefileext(ExtractFileName(filepath), '.bat'));
  rewrite(bat);
  writeln(bat, 'echo off');
  writeln(bat,'echo 谢谢使用文件分割 XCut 1.0 .....');
  writeln(bat, 'echo .');
  writeln(bat,'echo 正在准备生成文件' extractfilename(filepath));
  writeln(bat, 'echo .');
  writeln(bat,' echo 您可以按 CTRL Z 键 中止,其他键继续!');

  writeln(bat,'pause');

  for i := 1 to FileCount 1 do
  begin
  if i = 1
  then writeln(bat, 'copy ' extractfilename(Filepath) '.1/b ' extractfilename(Filepath))
  else writeln(bat, 'copy ' extractfilename(Filepath) '/b ' extractfilename(Filepath) '.' inttostr(i) '/b');

  end;

  memo1.lines.add('正在生成合并命令文件: ' changefileext(extractfilename(Filepath), '.bat'));

  closefile(bat);

  memo1.lines.add('切割成功完成!');
  Application.MessageBox('切割成功完成!', '恭喜', MB_OK MB_ICONINFORMATION);

end;
procedure TXCutForm.Button4Click(Sender: TObject);
begin
  close;
end;

end.

.
├── 找例子网_文件切割器.7z
└── 文件切割器
    ├── DestPath.dcu
    ├── DestPath.ddp
    ├── DestPath.dfm
    ├── DestPath.pas
    ├── MainUnit.dcu
    ├── MainUnit.ddp
    ├── MainUnit.dfm
    ├── MainUnit.pas
    ├── MainUnit.~ddp
    ├── MainUnit.~dfm
    ├── MainUnit.~pas
    ├── XCut.cfg
    ├── XCut.dof
    ├── XCut.dpr
    └── XCut.res

1 directory, 16 files

评论

发表评论必须先登陆, 您可以 登陆 或者 注册新账号 !


在线咨询: 问题反馈
客服QQ:174666394

有问题请留言,看到后及时答复